home *** CD-ROM | disk | FTP | other *** search
/ Gold Medal Software 1 / Gold Medal Software Volume 1 (Gold Medal) (1994).iso / prog / tpwprog7.arj / UBITMAP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-07-02  |  3.6 KB  |  144 lines
  1. { ubitmap.pas -- Load DIB bitmap .BMP files }
  2.  
  3. unit UBitmap;
  4.  
  5. interface
  6.  
  7. uses WinTypes, WinProcs;
  8.  
  9. function LoadBitmap(FileName: PChar; HWindow: HWnd;
  10.   var Width, Height: LongInt): HBitmap;
  11.  
  12. implementation
  13.  
  14. { Required for segment arithmetic in GetBitmapData }
  15. procedure AHIncr; far; external 'KERNEL' index 114;
  16.  
  17. procedure GetBitmapData(var TheFile: File;
  18.   BitsHandle: THandle; BitsByteSize: Longint);
  19. type
  20.   LongType = record
  21.     case Word of
  22.       0: (Ptr: Pointer);
  23.       1: (Long: Longint);
  24.       2: (Lo: Word;
  25.       Hi: Word);
  26.   end;
  27. var
  28.   Count: Longint;
  29.   Start, ToAddr, Bits: LongType;
  30. begin
  31.   Start.Long := 0;
  32.   Count := BitsByteSize;
  33.   Bits.Ptr := GlobalLock(BitsHandle);
  34.   if Bits.Ptr <> nil then
  35.   begin
  36.     while Count > 0 do
  37.     begin
  38.       ToAddr.Hi := Bits.Hi + (Start.Hi * Ofs(AHIncr));
  39.       ToAddr.Lo := Start.Lo;
  40.       if Count > $4000 then Count := $4000;
  41.       BlockRead(TheFile, ToAddr.Ptr^, Count);
  42.       Start.Long := Start.Long + Count;
  43.       Count := BitsByteSize - Start.Long
  44.     end;
  45.     GlobalUnlock(BitsHandle)
  46.   end
  47. end;
  48.  
  49. {- True if file F is a bitmap file. If true, F is opened. }
  50. function IsBitmapFile(FileName: PChar; var F: File): Boolean;
  51. var
  52.   TestValue: LongInt;
  53. begin
  54.   IsBitmapFile := false;
  55.   Assign(F, FileName);
  56.   {$I-} Reset(F, 1); {$I+}
  57.   if IoResult = 0 then
  58.   begin
  59.     Seek(F, 14);
  60.     BlockRead(F, TestValue, SizeOf(TestValue));
  61.     if TestValue = $28 then
  62.       IsBitmapFile := true
  63.     else
  64.       Close(F)
  65.   end
  66. end;
  67.  
  68. {- Load DIB bitmap file. Return handle if successful, else return 0.}
  69. function LoadBitmap(FileName: PChar; HWindow: HWnd;
  70.   var Width, Height: LongInt): HBitmap;
  71. var
  72.   BitmapInfo: PBitmapInfo;
  73.   BmpHandle: THandle;
  74.   BitmapSize: Word;
  75.   HeaderSize: Word;
  76.   LWidth: Longint;
  77.   PBits: Pointer;
  78.   F: File;
  79.   DC: HDC;
  80. begin
  81.  
  82.   LoadBitmap := 0;  { Preset function result to "null" }
  83.  
  84.   if IsBitmapFile(FileName, F) then
  85.   begin
  86.  
  87. {- Load bitmap header information at offset 28 }
  88.  
  89.     Seek(F, 28);
  90.     BlockRead(F, BitmapSize, SizeOf(BitmapSize));
  91.     if BitmapSize <= 8 then
  92.     begin
  93.       HeaderSize := SizeOf(TBitmapInfoHeader) +
  94.         ((1 shl BitmapSize) * SizeOf(TRGBQuad));
  95.       GetMem(BitmapInfo, HeaderSize);
  96.       if BitmapInfo <> nil then
  97.       begin
  98.  
  99. {- Get width and height of bitmap in pixels }
  100.  
  101.         with BitmapInfo^, BMIHeader do
  102.         begin
  103.           Seek(F, SizeOf(TBitmapFileHeader));
  104.           BlockRead(F, BitmapInfo^, HeaderSize);
  105.           Width := BIWidth;
  106.           Height := BIHeight;
  107.  
  108. {- Load DIB image }
  109.  
  110.           LWidth := (((Width * BitmapSize) + 31) div 32) * 4;
  111.           BISizeImage := LWidth * Height;
  112.           GlobalCompact(-1);
  113.           BmpHandle := GlobalAlloc(gmem_Moveable or gmem_Zeroinit,
  114.             BISizeImage);
  115.           if BmpHandle <> 0 then
  116.           begin
  117.             GetBitmapData(F, BmpHandle, BISizeImage);
  118.             PBits := GlobalLock(BmpHandle);
  119.             if PBits <> nil then
  120.             begin
  121.               DC := CreateDC('Display', nil, nil, nil);
  122.               LoadBitmap := CreateDIBitmap(DC, BMIHeader, cbm_Init,
  123.                 PBits, BitmapInfo^, 0);
  124.               DeleteDC(DC);
  125.               GlobalUnlock(BmpHandle)
  126.             end;
  127.             GlobalFree(BmpHandle)
  128.           end
  129.         end;
  130.         FreeMem(BitmapInfo, HeaderSize)
  131.       end
  132.     end;
  133.     Close(F)
  134.   end
  135. end;
  136.  
  137. end.
  138.  
  139.  
  140. {--------------------------------------------------------------
  141.   Copyright (c) 1991 by Tom Swan. All rights reserved.
  142.   Revision 1.00    Date: 2/25/1991
  143. ---------------------------------------------------------------}
  144.